home *** CD-ROM | disk | FTP | other *** search
-
- /* Copyright (C) 1988, 1989 Herve' Touati, Aquarius Project, UC Berkeley */
-
- % Merge-Split Parallel Sorting Algorithm
- % See: Parallel Sorting Alorithms by Selim G. Akl
- % 1985, Toronto, Academic Press
- % 20-May-86 Mike Carlton
-
- main :- main(50).
-
- main(P) :-
- make_list(Unsorted),
- mergesplit(P, Unsorted, Sorted),
- length(Unsorted, L),
- write(L), write(' numbers with '), write(P), write(' processors'), nl,
- write(Sorted), nl.
-
- mergesplit(P, Sorted) :-
- atom(P),
- make_list(Unsorted),
- mergesplit(P, Unsorted, Sorted).
- mergesplit(Unsorted, Sorted) :-
- get_processors(P), % Find the number of processes to use
- mergesplit(P, Unsorted, Sorted).
- mergesplit(P, Unsorted, Sorted) :-
- binpack(Unsorted, P, Bins), % Break list into P lists
- binsort(Bins, SortedBins), % Sort each of the P lists
- mrgsplt(SortedBins, P, NewBins), % Sort the whole list
- unbinpack(NewBins, Sorted). % Remove from bins
-
- binpack(Unsorted, P, Bins) :- % Breaks the list Unsorted into P Bins
- makeempty(P, Emptybins), % Make P empty lists
- bin2(Unsorted, Emptybins, Bins). % Do the work
-
- bin2([], Bins, Bins). % Stop
- bin2(Unsorted, BinsSoFar, Bins) :-
- bin3(Unsorted, Rest, BinsSoFar, NewBins), % Move 1 elt. from Unsorted to
- bin2(Rest, NewBins, Bins). % each bin and then do the rest
-
- bin3(Rest, Rest, [], []). % Stop when no more bins
- bin3([H1|T1], Rest, [H2|T2], [[H1|H2]|T3]) :- % Move H1 to head of 1st bin
- bin3(T1, Rest, T2, T3). % do the rest
- bin3([], Rest, [H2|T2], [H2|T3]) :- % If out of unsorted elts. copy bin
- bin3([], Rest, T2, T3).
-
- makeempty(0, []). % Stop when no more to build
- makeempty(Count, [[]|T]) :- % Add [] to the list
- NewCount is Count-1, % Decrement
- makeempty(NewCount, T). % Do the rest
-
- binsort([], []). % Stop when no more
- binsort([FirstBin|Bins], [SortedBin|Rest]) :- % Add the next bin sorted
- quicksort(FirstBin, SortedBin), % Sort FirstBin
- binsort(Bins, Rest). % do the rest
-
- quicksort(Unsorted, Sorted) :- % Quicksort using difference lists
- qsort(Unsorted, Sorted-[]).
-
- qsort([], Rest-Rest). % Stop
- qsort([X|Unsorted], Sorted-Rest) :-
- partition(Unsorted, X, Smaller, Larger), % Partition around 1st elt
- qsort(Smaller, Sorted-[X|Sorted1]), % Sort the first half
- qsort(Larger, Sorted2-Rest), % Sort the second half
- Sorted2 = Sorted1. % Unify ( for parallel qsort calls )
-
- partition([], _, [], []). % Stop
- partition([X|Xs], A, Smaller, [X|Larger]) :- % Add next elt. to larger list
- A < X, % if is larger than partition
- partition(Xs, A, Smaller, Larger). % do the rest
- partition([X|Xs], A, [X|Smaller], Larger) :- % Add next elt. to smaller list
- A >= X, % if is smaller than partition
- partition(Xs, A, Smaller, Larger). % do the rest
-
- mrgsplt(Sorted, 0, Sorted). % Stop
- mrgsplt(Sortedbins, Count, Sorted) :- % Sort the whole list
- odd(Count), % if an odd iteration
- mrgandsplt(Sortedbins,NewSortedBins), % merge and split once
- NewCount is Count-1, % decrement
- mrgsplt(NewSortedBins, NewCount, Sorted). % and do the rest
- mrgsplt([First|Sortedbins], Count, Sorted) :- % Sort the whole list
- even(Count), % if an even iteration
- mrgandsplt(Sortedbins,NewSortedBins), % merge and split once
- NewCount is Count-1, % decrement
- mrgsplt([First|NewSortedBins], NewCount, Sorted). % and do the rest
-
- mrgandsplt([], []). % Stop when none left
- mrgandsplt([Chunk],[Chunk]). % or if only 1 left
- mrgandsplt([Chunk1, Chunk2|Rest], [NewChunk1, NewChunk2|Sorted]) :-
- merge(Chunk1, Chunk2, 0, Length, Chunk), % merge into Chunk
- split(Chunk, Length, NewChunk1, NewChunk2), % split Chunk
- mrgandsplt(Rest,Sorted). % do the rest
-
- merge([], [], Len, Len, []). % merge nothings to nothing
- merge(H1, [], OldLen, NewLen, H1) :- % second list empty
- length(H1, Len),
- NewLen is OldLen+Len. % count first list's length
- merge([], H2, Len, Len, H2). % first list empty
- merge([H1|T1], [H2|T2], OldLen, NewLen, [H1|T3]) :-
- H1 =< H2, % copy from first list
- Len is OldLen+1, % inc. length
- merge(T1, [H2|T2], Len, NewLen, T3). % do the rest
- merge([H1|T1], [H2|T2], Len, NewLen, [H2|T3]) :-
- H2 < H1, % copy from second list
- merge([H1|T1], T2, Len, NewLen, T3). % do the rest
-
- split(Chunk, 0, [], Chunk).
- split([H|T], Length, [H|Chunk1], Chunk2) :-
- NewLength is Length-1,
- split(T, NewLength, Chunk1, Chunk2).
-
- make_list([50,48,46,44,42,40,38,36,34,32,30,28,26,24,22,20,18,
- 16,14,12,10, 8, 6, 4, 2, 1, 3, 5, 7, 9,11,13,15,17,
- 19,21,23,25,27,29,31,33,35,37,39,41,43,45,47,49,
- 50,48,46,44,42,40,38,36,34,32,30,28,26,24,22,20,18,
- 16,14,12,10, 8, 6, 4, 2, 1, 3, 5, 7, 9,11,13,15,17,
- 19,21,23,25,27,29,31,33,35,37,39,41,43,45,47,49,
- 50,48,46,44,42,40,38,36,34,32,30,28,26,24,22,20,18,
- 16,14,12,10, 8, 6, 4, 2, 1, 3, 5, 7, 9,11,13,15,17,
- 19,21,23,25,27,29,31,33,35,37,39,41,43,45,47,49,
- 50,48,46,44,42,40,38,36,34,32,30,28,26,24,22,20,18,
- 16,14,12,10, 8, 6, 4, 2, 1, 3, 5, 7, 9,11,13,15,17,
- 19,21,23,25,27,29,31,33,35,37,39,41,43,45,47,49,
- 50,48,46,44,42,40,38,36,34,32,30,28,26,24,22,20,18,
- 16,14,12,10, 8, 6, 4, 2, 1, 3, 5, 7, 9,11,13,15,17,
- 19,21,23,25,27,29,31,33,35,37,39,41,43,45,47,49]).
- get_processors(3). % number of processors
-
- unbinpack(Bins, UnBins) :-
- unbinpack(Bins, [], UnBins).
- unbinpack([], SoFar, SoFar).
- unbinpack([H|T], SoFar, UnBins) :-
- append(SoFar, H, NewSoFar),
- unbinpack(T, NewSoFar, UnBins).
-
- append([], L, L).
- append([X|L1], L2, [X|L3]) :-
- append(L1, L2, L3).
-
- even(N) :-
- 0 is N mod 2.
-
- odd(N) :-
- 1 is N mod 2.
-
-